home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 10 / BBS In A Box Volume X (AMUG) (January 1994).bin / Files / Prog / T / Tri-Menu.cpt / Routines < prev   
Encoding:
Text File  |  1993-07-08  |  9.1 KB  |  350 lines  |  [TEXT/PJMM]
  1. unit Routines;
  2. interface
  3.     type
  4.         TriMenuPanels = array[1..2, 1..1] of Rect;
  5.     const
  6.         Frame = False;
  7.     var
  8.         Screen, HArrow, HArrowMask, VArrow, VArrowMask, VirginPort: GrafPtr;
  9.         Place, PlaceII: Rect;
  10.         ArrowDown, WasInQ, WasInA: Boolean;
  11.         TriMenu: TriMenuPanels;
  12.         RightPanel: Integer;
  13.  
  14.     function CreateOSPort (BitRect: Rect): GrafPtr;
  15.     procedure WindowInit;
  16.     procedure LoademUp;
  17.     procedure GetPictSize (EyeD1: integer; var Size: Rect);
  18.     procedure PrepArrows;
  19.     procedure DrawFirstArrow;
  20.     procedure DoEvents;
  21.     function InRect (R1: Rect; P: Point): Boolean;
  22.     procedure DownTri;
  23.     procedure UpTri;
  24.     procedure DrawTriMenu;
  25.     procedure DoAbout;
  26.     procedure DoQuit;
  27.     procedure TraceMouse;
  28.  
  29. implementation
  30.     function CreateOSPort (BitRect: Rect): GrafPtr;
  31.         var
  32.             OffScreen: GrafPtr;
  33.             BaseAddr: Ptr;
  34.             Rowbytes: integer;
  35.     begin
  36.         GetPort(Screen);
  37.         OffScreen := GrafPtr(NewPtr(Sizeof(GrafPort)));
  38.         if (Offscreen <> nil) then
  39.             begin
  40.                 OpenPort(Offscreen);
  41.                 Rowbytes := ((BitRect.Right - BitRect.Left + 15) div 16) * 2;
  42.                 BaseAddr := NewPtr(Rowbytes * Longint((BitRect.Bottom - BitRect.Top)));
  43.                 if (BaseAddr <> nil) then
  44.                     begin
  45.                         OffScreen^.PortBits.Rowbytes := RowBytes;
  46.                         OffScreen^.PortBits.BaseAddr := BaseAddr;
  47.                         OffScreen^.PortRect := BitRect;
  48.                         OffScreen^.PortBits.Bounds := BitRect;
  49.                         RectRgn(OffScreen^.ClipRgn, BitRect);
  50.                         RectRgn(OffScreen^.VisRgn, BitRect);
  51.                     end
  52.                 else
  53.                     begin
  54.                         ClosePort(OffScreen);
  55.                         DisposePtr(Ptr(Offscreen));
  56.                         OffScreen := nil;
  57.                     end;
  58.             end;
  59.         EraseRect(OffScreen^.PortBits.Bounds);
  60.         SetPort(Screen);
  61.         CreateOSPort := OffScreen;
  62.     end;
  63. {****************************************************************************}
  64.     procedure WindowInit;
  65.         var
  66.             HelloWindow: WindowPtr;
  67.     begin
  68.         InitCursor;
  69.         helloWindow := GetNewWindow(600, nil, Pointer(-1));
  70.         ShowWindow(HelloWindow);
  71.         SetPort(HelloWindow);
  72.     end;
  73. {****************************************************************************}
  74.     procedure GetPictSize (EyeD1: integer; var Size: Rect);
  75.         var
  76.             Picture: PicHandle;
  77.     begin
  78.         Picture := GetPicture(EyeD1);
  79.         Size := Picture^^.PicFrame;
  80.     end;
  81. {****************************************************************************}
  82.     procedure PrepArrows;
  83.         var
  84.             Size: Rect;
  85.     begin
  86.         GetPictSize(10000, Size);
  87.         HArrow := CreateOSPort(Size);
  88.         GetPictSize(10001, Size);
  89.         HArrowMask := CreateOSPort(Size);
  90.         GetPictSize(10002, Size);
  91.         VArrow := CreateOSPort(Size);
  92.         GetPictSize(10003, Size);
  93.         VArrowMask := CreateOSPort(Size);
  94.         with Size do
  95.             begin
  96.                 Right := Right + 1;
  97.                 Left := Left + 1;
  98.                 Top := Top + 1;
  99.                 Bottom := Bottom + 1;
  100.             end;
  101.         VirginPort := CreateOSPort(Size);
  102.         LoademUp;
  103.     end;
  104. {****************************************************************************}
  105.     procedure LoademUp;
  106.         var
  107.             Picture: PicHandle;
  108.             A, B: integer;
  109.     begin
  110.         for A := 0 to 3 do
  111.             begin
  112.                 B := 10000 + A;
  113.                 Picture := GetPicture(B);
  114.                 case A of
  115.                     0: 
  116.                         begin
  117.                             SetPort(HArrow);
  118.                             DrawPicture(Picture, HArrow^.PortBits.Bounds);
  119.                         end;
  120.                     1: 
  121.                         begin
  122.                             SetPort(HArrowMask);
  123.                             DrawPicture(Picture, HArrowMask^.PortBits.Bounds);
  124.                         end;
  125.                     2: 
  126.                         begin
  127.                             SetPort(VArrow);
  128.                             DrawPicture(Picture, VArrow^.PortBits.Bounds);
  129.                         end;
  130.                     3: 
  131.                         begin
  132.                             SetPort(VArrowMask);
  133.                             DrawPicture(Picture, VArrowMask^.PortBits.Bounds);
  134.                         end;
  135.                 end;{Case Statement}
  136.             end;
  137.         SetPort(Screen);
  138.     end;
  139. {****************************************************************************}
  140.     procedure DrawFirstArrow;
  141.         var
  142.             Dummy: Longint;
  143.             AboutSize, QuitSize: Rect;
  144.     begin
  145.         SetRect(Place, 50, 50, 58, 63);
  146.         SetRect(PlaceII, 46, 53, 59, 61);
  147.         ArrowDown := false;
  148.         CopyMask(HArrow^.PortBits, HArrowMask^.PortBits, Screen^.PortBits, HArrow^.PortBits.Bounds, HArrowMask^.PortBits.Bounds, Place);
  149.         MoveTo(65, 61);
  150.         TextSize(10);
  151.         DrawString('Tri-Menu');
  152.         RightPanel := StringWidth('Tri-Menu');
  153.         SetRect(AboutSize, 83, 68, 65 + RightPanel, 80);
  154.         SetRect(QuitSize, 83, 83, 65 + RightPanel, 95);
  155.         TriMenu[1, 1] := AboutSize;
  156.         TriMenu[2, 1] := QuitSize;
  157.     end;
  158. {****************************************************************************}
  159.     procedure DoEvents;
  160.         var
  161.             GotOne, InTri, InAbout, InQuit: Boolean;
  162.             TheEvent: EventRecord;
  163.             TheChar: Char;
  164.     begin
  165.         GotOne := false;
  166.         repeat
  167.             GotOne := WaitNextEvent(EveryEvent, TheEvent, 60, nil);
  168.             if (ArrowDown = true) then
  169.                 TraceMouse;
  170.         until GotOne;
  171.         case TheEvent.What of
  172.             MouseDown: 
  173.                 begin
  174.                     if (ArrowDown = false) then
  175.                         begin
  176.                             GlobalToLocal(TheEvent.Where);
  177.                             InTri := InRect(Place, TheEvent.Where);
  178.                             if (InTri = true) then
  179.                                 DownTri;
  180.                         end;
  181.                     if (ArrowDown = true) then
  182.                         begin
  183.                             GlobalToLocal(TheEvent.Where);
  184.                             InTri := InRect(PlaceII, TheEvent.Where);
  185.                             if (InTri = true) then
  186.                                 UpTri
  187.                             else
  188.                                 begin
  189.                                     InAbout := InRect(TriMenu[1, 1], TheEvent.Where);
  190.                                     if (InAbout = true) then
  191.                                         DoAbout
  192.                                     else
  193.                                         begin
  194.                                             InQuit := InRect(TriMenu[2, 1], TheEvent.Where);
  195.                                             if (InQuit = true) then
  196.                                                 DoQuit;
  197.                                         end;{InQuit}
  198.                                 end;{NotInTri}
  199.                         end;{ArrowDown = true}
  200.                 end;{MouseDown Case}
  201.             KeyDown, AutoKey: 
  202.                 begin
  203.                     TheChar := CHR(BitAnd(TheEvent.Message, CharCodeMask));
  204.                     if (TheChar = 'Q') or (TheChar = 'q') then
  205.                         Halt;
  206.                 end;
  207.             otherwise
  208.                 begin
  209.                 end;
  210.         end;{Case statement}
  211.     end;
  212. {****************************************************************************}
  213.     function InRect (R1: Rect; P: Point): Boolean;
  214.         var
  215.             number: integer;
  216.     begin
  217.         with P, R1 do
  218.             begin
  219.                 if (H > Left) and (H < Right) and (V > Top) and (V < Bottom) then
  220.                     InRect := true
  221.                 else
  222.                     InRect := false;
  223.             end;
  224.     end;
  225. {****************************************************************************}
  226.     procedure DownTri;
  227.         var
  228.             Dummy: Longint;
  229.     begin
  230.         ArrowDown := True;
  231.         CopyMask(HArrowMask^.PortBits, HArrowMask^.PortBits, Screen^.PortBits, HArrow^.PortBits.Bounds, HArrowMask^.PortBits.Bounds, Place);
  232.         Delay(10, Dummy);
  233.         CopyBits(VirginPort^.PortBits, Screen^.PortBits, VirginPort^.PortBits.Bounds, Place, 0, nil);
  234.         CopyMask(VArrowMask^.PortBits, VArrowMask^.PortBits, Screen^.PortBits, VArrow^.PortBits.Bounds, VArrowMask^.PortBits.Bounds, PlaceII);
  235.         Delay(30, Dummy);
  236.         CopyMask(VArrow^.PortBits, VArrowMask^.PortBits, Screen^.PortBits, VArrow^.PortBits.Bounds, VArrowMask^.PortBits.Bounds, PlaceII);
  237.         DrawTriMenu;
  238.     end;
  239. {****************************************************************************}
  240.     procedure UpTri;
  241.         var
  242.             Dummy: Longint;
  243.             ClearMenu: Rect;
  244.     begin
  245.         SetRect(ClearMenu, 65, TriMenu[1, 1].Top, 66 + RightPanel, TriMenu[2, 1].bottom);
  246.         ArrowDown := false;
  247.         CopyMask(VArrowMask^.PortBits, VArrowMask^.PortBits, Screen^.PortBits, VArrow^.PortBits.Bounds, VArrowMask^.PortBits.Bounds, PlaceII);
  248.         Delay(10, Dummy);
  249.         CopyBits(VirginPort^.PortBits, Screen^.PortBits, VirginPort^.PortBits.Bounds, PlaceII, 0, nil);
  250.         CopyMask(HArrowMask^.PortBits, HArrowMask^.PortBits, Screen^.PortBits, HArrow^.PortBits.Bounds, HArrowMask^.PortBits.Bounds, Place);
  251.         Delay(30, Dummy);
  252.         EraseRect(ClearMenu);
  253.         CopyMask(HArrow^.PortBits, HArrowMask^.PortBits, Screen^.PortBits, HArrow^.PortBits.Bounds, HArrowMask^.PortBits.Bounds, Place);
  254.     end;
  255. {****************************************************************************}
  256.     procedure DrawTriMenu;
  257.         var
  258.             StringLength: integer;
  259.     begin
  260.         if (Frame = True) then
  261.             begin
  262.                 FrameRect(TriMenu[1, 1]);
  263.                 FrameRect(TriMenu[2, 1]);
  264.             end;
  265.         StringLength := StringWidth('About ');
  266.         MoveTo(85, 78);
  267.         DrawString('About');
  268.         StringLength := StringWidth('Quit ');
  269.         MoveTo(85, 93);
  270.         DrawString('Quit');
  271.     end;
  272. {****************************************************************************}
  273.     procedure DoQuit;
  274.     begin
  275.         Halt;
  276.     end;
  277. {****************************************************************************}
  278.     procedure TraceMouse;
  279.         var
  280.             InAbout, InQuit: boolean;
  281.             Location: point;
  282.     begin
  283.         GetMouse(Location);
  284.         InAbout := InRect(TriMenu[1, 1], Location);
  285.         InQuit := InRect(TriMenu[2, 1], Location);
  286.         if (InQuit = false) and (WasInQ = true) then
  287.             begin
  288.                 WasInQ := false;
  289.                 InvertRect(TriMenu[2, 1]);
  290.             end;
  291.         if (InAbout = True) then
  292.             begin
  293.                 if (WasInA = false) then
  294.                     begin
  295.                         InvertRect(TriMenu[1, 1]);
  296.                         WasInA := True;
  297.                         WasInQ := false;
  298.                     end
  299.                 else
  300.                     begin
  301.                     end;
  302.             end;{InAbout}
  303.         if (InAbout = False) and (WasInA = true) then
  304.             begin
  305.                 WasInA := false;
  306.                 InvertRect(TriMenu[1, 1]);
  307.             end;
  308.         if (InQuit = True) then
  309.             begin
  310.                 if (WasInQ = false) then
  311.                     begin
  312.                         InvertRect(TriMenu[2, 1]);
  313.                         WasInQ := True;
  314.                         WasInA := false;
  315.                     end
  316.                 else
  317.                     begin
  318.                     end;
  319.             end;{InQuit}
  320.     end;
  321. {****************************************************************************}
  322.     procedure DoAbout;
  323.         var
  324.             TheDialog: DialogPtr;
  325.             DialogDone: boolean;
  326.             ItemHit: integer;
  327.     begin
  328.         TheDialog := GetNewDialog(400, nil, WindowPtr(-1));
  329.         ShowWindow(TheDialog);
  330.         while DialogDone = False do
  331.             begin
  332.                 ModalDialog(nil, ItemHit);
  333.                 case ItemHit of
  334.                     2: 
  335.                         begin
  336.                             Dialogdone := true;
  337.                         end;
  338.                     otherwise
  339.                         begin
  340.                         end;
  341.                 end;{Case}
  342.             end;{While}
  343.         HideWindow(TheDialog);
  344.     end;
  345. end.
  346.  
  347.  
  348.  
  349.  
  350.